home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d1 / mntsort.arc / MNTSORT.BAS < prev    next >
BASIC Source File  |  1985-01-15  |  3KB  |  57 lines
  1. 10 ' ------------------------------------------------------------------
  2. 11 ' ---      This is a product of Mentat Software (c)1984-85
  3. 12 ' ---      it is freely given.  Feel free to use it as you
  4. 13 ' ---      wish but the first 16 lines of this message must
  5. 14 ' ---      remain intact.
  6. 15 ' ---           If you find this product or any Mentat
  7. 16 ' ---      Software products or any of the older software
  8. 17 ' ---      products written by Richard Ashwell, please feel
  9. 18 ' ---      free to contribute or donate. Send any contribu-
  10. 19 ' ---      tion to:
  11. 20 ' ---
  12. 21 ' ---             Richard F. Ashwell III
  13. 22 ' ---             1830 Dover Rd.
  14. 23 ' ---             Dover Fl.   33527
  15. 24 ' ---
  16. 25 ' ---        ============( Line 16 )===============
  17. 26 ' ---
  18. 27 ' ---         If you send a SASE, we will send you a brochure
  19. 28 ' ---     on our software and how to get it.
  20. 29 ' ---
  21. 30 ' ---     To Recieve the Mentat Sort programs send either:
  22. 31 ' ---
  23. 32 ' ---       1 DISK WITH RETURN MAILER &  $4
  24. 33 ' ---
  25. 34 ' ---     OR
  26. 35 ' ---
  27. 36 ' ---       A RETURN MAILER & $10 DOLLAR.  (SPECIFY DISK FORMAT)
  28. 37 ' ------------------------------------------------------------------
  29. 40 DIM D$(5000),PLANE(3000),WAVE(3000):SCREEN 0,0,0:WIDTH 80:CLS:KEY OFF:A$="MENTAT SORT":LOCATE 1,40-LEN(A$)/2:PRINT A$:A$="-----------":LOCATE 2,40-LEN(A$)/2:PRINT A$
  30. 50 LOCATE 23,1:PRINT"Mentat Software (c)1984-85     written by   Richard F. Ashwell III"
  31. 60 LOCATE 3,1:PRINT"5000 entry limit.":PRINT:INPUT"Enter input file name... -->",NA$:PRINT:PRINT"Enter output file name. Use 'LPT1:' for printer and 'SCRN:' for screen output.":PRINT:INPUT"---->",N2$:ON ERROR GOTO 300:OPEN NA$ FOR INPUT AS #1
  32. 70 IF EOF(1) THEN CLOSE #1:GOTO 90
  33. 80 Y=Y+1:INPUT #1,D$(Y):GOTO 70
  34. 90 OPEN N2$ FOR OUTPUT AS #1:CLS:A$="-MENTAT WORKING-":COLOR 7:LOCATE 1,1:PRINT A$:LT=2:GOSUB 310:DREG=1:PLANE(DREG)=1:WAVE(DREG)=Y:EREG=1:AREG=Y:LOCATE 23,1:PRINT"Mentat Software (c)1984-85    written by    Richard F. Ashwell III"
  35. 100 IF (AREG-EREG)<9 THEN GOTO 230
  36. 110 BREG=EREG:CREG=AREG
  37. 120 IF D$(BREG)>D$(CREG) THEN GOTO 170
  38. 130 CREG=CREG-1:IF CREG>BREG THEN GOTO 120
  39. 140 CREG=CREG+1
  40. 150 DREG=DREG+1:IF (BREG-EREG)<(AREG-CREG) THEN GOTO 220
  41. 160 PLANE(DREG)=EREG:WAVE(DREG)=BREG:EREG=CREG:GOTO 100
  42. 170 GOSUB 310:SWAP D$(CREG),D$(BREG):GOTO 190
  43. 180 IF D$(CREG)<D$(BREG) THEN GOTO 210
  44. 190 BREG=BREG+1:IF CREG>BREG THEN GOTO 180
  45. 200 CREG=CREG+1:GOTO 150
  46. 210 GOSUB 310:SWAP D$(CREG),D$(BREG):GOTO 130
  47. 220 PLANE(DREG)=CREG:WAVE(DREG)=AREG:AREG=BREG:GOTO 100
  48. 230 IF (AREG-EREG+1)=1 THEN GOTO 270
  49. 240 FOR BREG=(EREG+1) TO AREG:FOR CREG=EREG TO (BREG-1):FREG=BREG-CREG+EREG-1:IF D$(FREG)<=D$(FREG+1) THEN GOTO 260
  50. 250 SWAP D$(FREG),D$(FREG+1):NEXT CREG
  51. 260 NEXT BREG
  52. 270 EREG=PLANE(DREG):AREG=WAVE(DREG):DREG=DREG-1:IF DREG=0 THEN GOTO 290
  53. 280 GOTO 100
  54. 290 CLS:FOR X=1 TO Y:PRINT#1,D$(X):NEXT:CLOSE:END
  55. 300 SYSTEM
  56. 310 LOCATE 1,1:COLOR 7:PRINT LEFT$(A$,LT-1);:COLOR 15:PRINT MID$(A$,LT,1);:COLOR 7:PRINT RIGHT$(A$,LEN(A$)-LT):LT=LT+1:IF LT>LEN(A$)-1 THEN LT=2:RETURN ELSE RETURN
  57.